home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / Dev / Oberon / source / OC / OC.mod < prev    next >
Text File  |  1995-06-29  |  10KB  |  387 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OC.mod $
  4.   Description: Main entry point for the Oberon-A compiler.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.22 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/02 18:45:27 $
  10.  
  11.   Copyright © 1993-1995, Frank Copeland
  12.   This module forms part of the OC program
  13.   See OC.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *>
  20.  
  21. MODULE OC;
  22.  
  23. IMPORT
  24.  
  25.   SYS := SYSTEM, Kernel, Errors, e := Exec, ti := Timer, u := Utility,
  26.   d := Dos, du := DosUtil, Files, str := Strings, OCRev, OCStrings,
  27.   OCM, OCS, OCT, OCC, OCE, Compiler, wb := Workbench, i := Icon,
  28.   conv := Conversions, OCOut;
  29.  
  30. CONST
  31.  
  32.   CopyrightStr = "Copyright © 1993-95 Frank Copeland\n";
  33.  
  34. VAR
  35.  
  36.   startDir : d.FileLockPtr;
  37.  
  38.  
  39. (* -- Command line template and parsing ------------------------------- *)
  40.  
  41. CONST
  42.  
  43.   template =
  44.     "NS=NEWSYMFILE/S,BATCH/S,SETTINGS/K,FILES/M"
  45.     (* These are temporary and will disappear eventually *)
  46.     ",FORCE/S";
  47.  
  48.   template2 = "FILES/M";
  49.  
  50.   helpStr =
  51.     "\nSETTINGS/K        -- preferences file\n"
  52.     "FILES/M           -- source file(s)\n"
  53.     "NS=NEWSYMFILE/S   -- generate a new symbol file if necessary\n"
  54.     "BATCH/S           -- batch compile\n"
  55.     "See OC.doc for more details\n\n"
  56.     "Arguments ? ";
  57.  
  58. TYPE
  59.  
  60.   StringArray = POINTER [2] TO ARRAY MAX(INTEGER) OF e.LSTRPTR;
  61.  
  62. VAR
  63.  
  64.   rdArgs, rdArgs2 : d.RDArgsPtr;
  65.   args : RECORD [2] (d.ArgsStruct)
  66.     newSymFile,
  67.     batch
  68.       : d.ArgBool;
  69.     settings
  70.       : d.ArgString;
  71.     files
  72.       : d.ArgStringArray;
  73.     force
  74.       : d.ArgBool;
  75.   END;
  76.  
  77.   (* These are filled in by ParseArgs() *)
  78.  
  79.   newSymFile, batch : BOOLEAN;
  80.  
  81. (*------------------------------------*)
  82. PROCEDURE* Cleanup (VAR rc : LONGINT);
  83.  
  84.   VAR oldDir : d.FileLockPtr;
  85.  
  86. BEGIN (* Cleanup *)
  87.   IF rdArgs # NIL THEN
  88.     d.FreeArgs (rdArgs);
  89.     d.FreeDosObject (d.rdArgs, rdArgs);
  90.     rdArgs := NIL
  91.   END;
  92.   IF rdArgs2 # NIL THEN
  93.     (* d.FreeArgs (rdArgs2); *)
  94.     d.FreeDosObject (d.rdArgs, rdArgs2);
  95.     rdArgs2 := NIL
  96.   END;
  97.   IF Kernel.fromWorkbench THEN oldDir := d.CurrentDir (startDir) END
  98. END Cleanup;
  99.  
  100. (*------------------------------------*)
  101. PROCEDURE Init ();
  102.  
  103. BEGIN (* Init *)
  104.   Kernel.SetCleanup (Cleanup);
  105.  
  106.   rdArgs := d.AllocDosObjectTags (d.rdArgs, u.end);
  107.   rdArgs2 := d.AllocDosObjectTags (d.rdArgs, u.end);
  108.   ASSERT ((rdArgs # NIL) & (rdArgs2 # NIL));
  109.   rdArgs.extHelp := SYS.ADR (helpStr);
  110. END Init;
  111.  
  112. (*------------------------------------*)
  113. PROCEDURE CloneStr ( oldStr : e.LSTRPTR ) : e.LSTRPTR;
  114.   VAR newStr : e.LSTRPTR;
  115. BEGIN (* CloneStr *)
  116.   SYS.NEW (newStr, str.Length (oldStr^) + 1);
  117.   COPY (oldStr^, newStr^);
  118.   RETURN newStr
  119. END CloneStr;
  120.  
  121. (*------------------------------------*)
  122. PROCEDURE ParseArgs ();
  123.  
  124.   VAR
  125.     string : e.LSTRPTR; strings : StringArray;
  126.     i : INTEGER; ignore : BOOLEAN; ch : CHAR;
  127.     args2 : ARRAY 1 OF SYS.LONGWORD;
  128.  
  129.   (*------------------------------------*)
  130.   PROCEDURE ParseString (s, msg : ARRAY OF CHAR);
  131.  
  132.     VAR len : LONGINT; buffer : e.LSTRPTR;
  133.  
  134.   <*$CopyArrays-*>
  135.   BEGIN (* ParseString *)
  136.     len := str.Length (s) + 2;
  137.     SYS.NEW (buffer, len);
  138.     COPY (s, buffer^);
  139.     buffer [len-2] := "\n"; buffer [len-1] := 0X;
  140.     rdArgs2.source.buffer := buffer;
  141.     rdArgs2.source.length := len - 1;
  142.     rdArgs2.source.curChr := 0;
  143.     rdArgs2.daList := 0; rdArgs2.buffer := NIL; rdArgs2.bufSiz := 0;
  144.     rdArgs2.extHelp := NIL; rdArgs2.flags := {};
  145.     args2 [0] := NIL;
  146.     IF d.OldReadArgs (template2, args2, rdArgs2) = NIL THEN
  147.       ignore := d.PrintFault (d.IoErr(), msg);
  148.       HALT (d.warn)
  149.     END
  150.   END ParseString;
  151.  
  152. BEGIN (* ParseArgs *)
  153.   newSymFile := (args.newSymFile = e.LTRUE);
  154.   batch := (args.batch = e.LTRUE);
  155.  
  156.   IF args.settings = NIL THEN
  157.     ignore := OCM.LoadPrefs ("OC.prefs")
  158.   ELSE
  159.     IF ~OCM.LoadPrefs (args.settings^) THEN
  160.       OCOut.Str1 (OCStrings.OC1, args.settings^);
  161.       HALT (d.warn)
  162.     END
  163.   END;
  164.  
  165.   IF OCM.SetNames # "" THEN
  166.     ParseString (OCM.SetNames, " !! SET");
  167.     strings := SYS.VAL (StringArray, args2 [0]);
  168.     IF strings # NIL THEN
  169.       i := 0;
  170.       WHILE strings [i] # NIL DO
  171.         OCS.Set (strings [i]^);
  172.         INC (i)
  173.       END;
  174.     END;
  175.     d.FreeArgs (rdArgs2)
  176.   END;
  177.  
  178.   IF OCM.ClearNames # "" THEN
  179.     ParseString (OCM.ClearNames, " !! CLEAR");
  180.     strings := SYS.VAL (StringArray, args2 [0]);
  181.     IF strings # NIL THEN
  182.       i := 0;
  183.       WHILE strings [i] # NIL DO
  184.         OCS.Clear (strings [i]^);
  185.         INC (i)
  186.       END;
  187.     END;
  188.     d.FreeArgs (rdArgs2)
  189.   END;
  190.  
  191.   OCC.OpenBuffers (OCM.CodeSize, OCM.ConstSize);
  192.  
  193.   OCM.Force := (args.force = e.LTRUE);
  194. END ParseArgs;
  195.  
  196. (*------------------------------------*)
  197. PROCEDURE Main ();
  198.  
  199.   (*------------------------------------*)
  200.   PROCEDURE Greetings;
  201.   BEGIN (* Greetings *)
  202.     OCOut.Str (OCRev.vString);
  203.     OCOut.Str (CopyrightStr);
  204.     OCOut.Str0 (OCStrings.OC13);
  205.     OCOut.Ln;
  206.   END Greetings;
  207.  
  208.   (*------------------------------------*)
  209.   PROCEDURE WbArgs ();
  210.  
  211.     VAR
  212.       wbStartup : wb.WBStartupPtr;
  213.       oldDir    : d.FileLockPtr;
  214.       diskObj   : wb.DiskObjectPtr;
  215.       toolTypes : wb.ToolTypePtr;
  216.       string    : e.LSTRPTR;
  217.       arg       : INTEGER;
  218.       codeSize,
  219.       constSize : LONGINT;
  220.  
  221.   BEGIN (* WbArgs *)
  222.     ASSERT (i.base # NIL, 100);
  223.  
  224.     wbStartup := SYS.VAL (wb.WBStartupPtr, Kernel.WBenchMsg);
  225.  
  226.     (* Attempt to load the icon *)
  227.     startDir := d.CurrentDir (wbStartup.argList[0].lock);
  228.     diskObj := i.GetDiskObject (wbStartup.argList[0].name^);
  229.     IF diskObj # NIL THEN
  230.       toolTypes := diskObj.toolTypes;
  231.       string := i.FindToolType (toolTypes, "NEWSYMFILE");
  232.       IF string # NIL THEN args.newSymFile := e.LTRUE END;
  233.       string := i.FindToolType (toolTypes, "BATCH");
  234.       IF string # NIL THEN args.batch := e.LTRUE END;
  235.       string := i.FindToolType (toolTypes, "SETTINGS");
  236.       IF string # NIL THEN args.settings := CloneStr (string) END;
  237.       string := i.FindToolType (toolTypes, "FORCE");
  238.       IF string # NIL THEN args.force := e.LTRUE END;
  239.  
  240.       i.FreeDiskObject (diskObj)
  241.     END;
  242.     ParseArgs();
  243.     Greetings;
  244.     IF wbStartup.numArgs = 1 THEN
  245.       Compiler.Interactive (newSymFile)
  246.     ELSE
  247.       FOR arg := 1 TO (wbStartup.numArgs - 1) DO
  248.         oldDir := d.CurrentDir (wbStartup.argList [arg].lock);
  249.         IF batch THEN
  250.           Compiler.Batch (wbStartup.argList [arg].name^, newSymFile)
  251.         ELSE
  252.           Compiler.Compile (wbStartup.argList [arg].name^, newSymFile)
  253.         END;
  254.       END
  255.     END
  256.   END WbArgs;
  257.  
  258.   (*------------------------------------*)
  259.   PROCEDURE CliArgs ();
  260.     VAR ignore : BOOLEAN; i : INTEGER;
  261.   BEGIN (* CliArgs *)
  262.     IF d.ReadArgs (template, args, rdArgs) = NIL THEN
  263.       ignore := d.PrintFault (d.IoErr(), "ReadArgs");
  264.       HALT (d.warn)
  265.     END;
  266.     ParseArgs();
  267.     Greetings;
  268.     IF args.files = NIL THEN
  269.       Compiler.Interactive (newSymFile)
  270.     ELSE
  271.       i := 0;
  272.       WHILE args.files [i] # NIL DO
  273.         IF batch THEN Compiler.Batch (args.files [i]^, newSymFile)
  274.         ELSE Compiler.Compile (args.files [i]^, newSymFile)
  275.         END;
  276.         INC (i)
  277.       END;
  278.     END;
  279.   END CliArgs;
  280.  
  281. BEGIN (* Main *)
  282.   IF Kernel.fromWorkbench THEN WbArgs()
  283.   ELSE CliArgs()
  284.   END;
  285. END Main;
  286.  
  287. <*$ClearVars+*>
  288. BEGIN (* OC *)
  289.   ASSERT (e.SysBase.libNode.version >= 37);
  290.   Errors.Init;
  291.  
  292.   Init();
  293.   Main();
  294.  
  295.   IF Compiler.returnError THEN HALT (d.error)
  296.   ELSIF Compiler.returnWarn THEN HALT (d.warn)
  297.   END
  298. END OC.
  299.  
  300. (***************************************************************************
  301.  
  302.   $Log: OC.mod $
  303.   Revision 5.22  1995/06/02  18:45:27  fjc
  304.   - Greatly simplified command-line processing by deleting
  305.     arguments that overrode preferences settings.
  306.  
  307.   Revision 5.22  1995/05/29  21:24:55  fjc
  308.   - Greatly simplified the command line arguments, removing
  309.     the options for over-riding preferences settings.
  310.  
  311.   Revision 5.21  1995/05/19  16:07:23  fjc
  312.   - Uses module OCOut for console IO
  313.  
  314.   Revision 5.20  1995/05/16  20:00:49  fjc
  315.   - Removed references to OCGUI.
  316.  
  317.   Revision 5.19  1995/05/13  23:16:40  fjc
  318.   - Moved Compile(), Batch(), etc. to module Compiler.
  319.  
  320.   Revision 5.18  1995/05/08  17:02:46  fjc
  321.   - Now opens the GUI for interactive control.
  322.  
  323.   Revision 5.16  1995/04/02  13:59:56  fjc
  324.   - Added CODESIZE and CONSTSIZE arguments.
  325.   - Rewrote argument processing to use an ArgsStruct instead
  326.     of an array of LONGWORDs.
  327.  
  328.   Revision 5.15  1995/02/27  17:14:10  fjc
  329.   - Added SMALLCODE, LARGECODE, SMALLDATA, LARGEDATA,
  330.     REGISTER and NOREGISTER command line arguments.
  331.   - Deleted TRACE command line argument.
  332.  
  333.   Revision 5.14  1995/01/26  00:17:17  fjc
  334.   - Release 1.5
  335.  
  336.   Revision 5.13  1995/01/16  10:38:22  fjc
  337.   - Fixed bug where an attempt was made to Lock (NIL,...),
  338.     causing an Enforcer hit.
  339.  
  340.   Revision 5.12  1995/01/09  14:03:26  fjc
  341.   - Changed console output depending on OCM.Verbose.
  342.   - Removed command line arguments for icon names.
  343.   - Implemented Workbench arguments.
  344.  
  345.   Revision 5.11  1995/01/05  11:43:08  fjc
  346.   - Changed Compiler.forceCode to OCM.Force.
  347.   - Added QUIET, NODEBUG and NOICONS arguments, and fixed
  348.     handling of VERBOSE, DEBUG and MAKEICONS.
  349.  
  350.   Revision 5.10  1995/01/03  21:31:56  fjc
  351.   - Changed OCG to OCM.
  352.   - Changed to use catalogs:
  353.     - Uses OCM for console I/O instead of Out.
  354.     - Gets text from OCStrings instead of hard-coding it.
  355.   - Added support for preferences:
  356.     - Added preferences settings to command-line template.
  357.     - Added SETTINGS argument to load settings from a file.
  358.  
  359.   Revision 5.8  1994/12/16  17:49:00  fjc
  360.   - Added command-line options to specify file extensions.
  361.  
  362.   Revision 5.7  1994/11/13  11:44:09  fjc
  363.   - Fixed formatting of elapsed time reports.
  364.  
  365.   Revision 5.6  1994/10/23  16:37:22  fjc
  366.   - Replaced StdIO with In and Out for console IO.
  367.  
  368.   Revision 5.5  1994/09/25  18:17:32  fjc
  369.   - Changed CPOINTER declaration.
  370.  
  371.   Revision 5.4  1994/09/19  23:10:05  fjc
  372.   - Re-implemented Amiga library calls
  373.  
  374.   Revision 5.3  1994/09/16  18:13:12  fjc
  375.   - Now uses ReadArgs() to process arguments.
  376.   - Added SET and CLEAR arguments.
  377.  
  378.   Revision 5.2  1994/09/15  10:46:34  fjc
  379.   - Replaced switches with pragmas.
  380.   - Used Kernel instead of SYSTEM.
  381.   - No longer uses IntuiUtil.
  382.  
  383.   Revision 5.1  1994/09/03  19:29:08  fjc
  384.   - Bumped version number
  385.  
  386. ***************************************************************************)
  387.